home *** CD-ROM | disk | FTP | other *** search
/ Windows Game Programming for Dummies (2nd Edition) / WinGamProgFD.iso / pc / DirectX SDK / DXSDK / samples / Multimedia / VBSamples / Misc / DXSetup / path.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  2001-10-08  |  10.2 KB  |  320 lines
  1. VERSION 5.00
  2. Begin VB.Form frmPath 
  3.    BorderStyle     =   3  'Fixed Dialog
  4.    Caption         =   "#"
  5.    ClientHeight    =   4710
  6.    ClientLeft      =   150
  7.    ClientTop       =   1530
  8.    ClientWidth     =   5955
  9.    ClipControls    =   0   'False
  10.    BeginProperty Font 
  11.       Name            =   "MS Sans Serif"
  12.       Size            =   8.25
  13.       Charset         =   0
  14.       Weight          =   700
  15.       Underline       =   0   'False
  16.       Italic          =   0   'False
  17.       Strikethrough   =   0   'False
  18.    EndProperty
  19.    HasDC           =   0   'False
  20.    Icon            =   "path.frx":0000
  21.    LockControls    =   -1  'True
  22.    MaxButton       =   0   'False
  23.    MinButton       =   0   'False
  24.    NegotiateMenus  =   0   'False
  25.    ScaleHeight     =   4710
  26.    ScaleWidth      =   5955
  27.    ShowInTaskbar   =   0   'False
  28.    Begin VB.CommandButton cmdCancel 
  29.       Cancel          =   -1  'True
  30.       Caption         =   "#"
  31.       BeginProperty Font 
  32.          Name            =   "MS Sans Serif"
  33.          Size            =   8.25
  34.          Charset         =   0
  35.          Weight          =   400
  36.          Underline       =   0   'False
  37.          Italic          =   0   'False
  38.          Strikethrough   =   0   'False
  39.       EndProperty
  40.       Height          =   420
  41.       Left            =   4170
  42.       MaskColor       =   &H00000000&
  43.       TabIndex        =   7
  44.       Top             =   2640
  45.       Width           =   1560
  46.    End
  47.    Begin VB.CommandButton cmdOK 
  48.       Caption         =   "#"
  49.       Default         =   -1  'True
  50.       BeginProperty Font 
  51.          Name            =   "MS Sans Serif"
  52.          Size            =   8.25
  53.          Charset         =   0
  54.          Weight          =   400
  55.          Underline       =   0   'False
  56.          Italic          =   0   'False
  57.          Strikethrough   =   0   'False
  58.       EndProperty
  59.       Height          =   420
  60.       Left            =   4170
  61.       MaskColor       =   &H00000000&
  62.       TabIndex        =   6
  63.       Top             =   1890
  64.       Width           =   1560
  65.    End
  66.    Begin VB.DriveListBox drvDrives 
  67.       BeginProperty Font 
  68.          Name            =   "MS Sans Serif"
  69.          Size            =   8.25
  70.          Charset         =   0
  71.          Weight          =   400
  72.          Underline       =   0   'False
  73.          Italic          =   0   'False
  74.          Strikethrough   =   0   'False
  75.       EndProperty
  76.       Height          =   315
  77.       Left            =   216
  78.       TabIndex        =   5
  79.       Top             =   4140
  80.       Width           =   3510
  81.    End
  82.    Begin VB.DirListBox dirDirs 
  83.       BeginProperty Font 
  84.          Name            =   "MS Sans Serif"
  85.          Size            =   8.25
  86.          Charset         =   0
  87.          Weight          =   400
  88.          Underline       =   0   'False
  89.          Italic          =   0   'False
  90.          Strikethrough   =   0   'False
  91.       EndProperty
  92.       Height          =   1605
  93.       Left            =   204
  94.       TabIndex        =   3
  95.       Top             =   1896
  96.       Width           =   3510
  97.    End
  98.    Begin VB.TextBox txtPath 
  99.       BeginProperty Font 
  100.          Name            =   "MS Sans Serif"
  101.          Size            =   8.25
  102.          Charset         =   0
  103.          Weight          =   400
  104.          Underline       =   0   'False
  105.          Italic          =   0   'False
  106.          Strikethrough   =   0   'False
  107.       EndProperty
  108.       Height          =   288
  109.       Left            =   204
  110.       MaxLength       =   240
  111.       TabIndex        =   1
  112.       Top             =   1056
  113.       Width           =   5532
  114.    End
  115.    Begin VB.Label lblDrives 
  116.       AutoSize        =   -1  'True
  117.       Caption         =   "#"
  118.       BeginProperty Font 
  119.          Name            =   "MS Sans Serif"
  120.          Size            =   8.25
  121.          Charset         =   0
  122.          Weight          =   400
  123.          Underline       =   0   'False
  124.          Italic          =   0   'False
  125.          Strikethrough   =   0   'False
  126.       EndProperty
  127.       Height          =   195
  128.       Left            =   210
  129.       TabIndex        =   4
  130.       Top             =   3870
  131.       Width           =   105
  132.    End
  133.    Begin VB.Label lblDirs 
  134.       AutoSize        =   -1  'True
  135.       Caption         =   "#"
  136.       BeginProperty Font 
  137.          Name            =   "MS Sans Serif"
  138.          Size            =   8.25
  139.          Charset         =   0
  140.          Weight          =   400
  141.          Underline       =   0   'False
  142.          Italic          =   0   'False
  143.          Strikethrough   =   0   'False
  144.       EndProperty
  145.       Height          =   195
  146.       Left            =   210
  147.       TabIndex        =   2
  148.       Top             =   1590
  149.       Width           =   105
  150.    End
  151.    Begin VB.Label lblPath 
  152.       AutoSize        =   -1  'True
  153.       Caption         =   "#"
  154.       BeginProperty Font 
  155.          Name            =   "MS Sans Serif"
  156.          Size            =   8.25
  157.          Charset         =   0
  158.          Weight          =   400
  159.          Underline       =   0   'False
  160.          Italic          =   0   'False
  161.          Strikethrough   =   0   'False
  162.       EndProperty
  163.       Height          =   195
  164.       Left            =   210
  165.       TabIndex        =   0
  166.       Top             =   750
  167.       Width           =   105
  168.    End
  169.    Begin VB.Label lblPrompt 
  170.       AutoSize        =   -1  'True
  171.       Caption         =   "*"
  172.       BeginProperty Font 
  173.          Name            =   "MS Sans Serif"
  174.          Size            =   8.25
  175.          Charset         =   0
  176.          Weight          =   400
  177.          Underline       =   0   'False
  178.          Italic          =   0   'False
  179.          Strikethrough   =   0   'False
  180.       EndProperty
  181.       Height          =   192
  182.       Left            =   204
  183.       TabIndex        =   8
  184.       Top             =   204
  185.       Width           =   5532
  186.       WordWrap        =   -1  'True
  187.    End
  188. Attribute VB_Name = "frmPath"
  189. Attribute VB_GlobalNameSpace = False
  190. Attribute VB_Creatable = False
  191. Attribute VB_PredeclaredId = True
  192. Attribute VB_Exposed = False
  193. Option Explicit
  194. Private mfMustExist As Integer
  195. Private mfCancelExit As Integer
  196. Private mfSinkEvents As Boolean
  197. Private Sub cmdCancel_Click()
  198.     If mfCancelExit Then
  199.         ExitSetup Me, gintRET_EXIT
  200.     Else
  201.         gintRetVal = gintRET_CANCEL
  202.         Unload Me
  203.     End If
  204. End Sub
  205. Private Sub cmdOK_Click()
  206.     Dim strPathName As String
  207.     Dim strMsg As String
  208.     Dim intRet As Integer
  209.     SetMousePtr vbHourglass
  210.     strPathName = ResolveDir(txtPath.Text, mfMustExist, True)
  211.     If Len(strPathName) > 0 Then
  212.         ' Avoid Option Compare Text and use explicit UCase comparisons because there
  213.         ' is a Unicode character (&H818F) which is equal to a path separator when
  214.         ' using Option Compare Text.
  215.         If UCase$(strPathName) <> UCase$(gstrDestDir) Then
  216.             If Not DirExists(strPathName) Then
  217.                 strMsg = ResolveResString(resDESTDIR) & vbLf & vbLf & strPathName
  218.                 strMsg = strMsg & vbLf & vbLf & ResolveResString(resCREATE)
  219.                 intRet = MsgFunc(strMsg, vbYesNo Or vbQuestion, gstrTitle)
  220.                 If gfNoUserInput Then
  221.                     ExitSetup Me, gintRET_FATAL
  222.                 End If
  223.                 If intRet = vbNo Then
  224.                     txtPath.SetFocus
  225.                     SetMousePtr vbDefault
  226.                     Exit Sub
  227.                 End If
  228.             End If
  229.             If Not IsValidDestDir(strPathName) Then
  230.                 txtPath.SetFocus
  231.                 SetMousePtr vbDefault
  232.                 Exit Sub
  233.             End If
  234.         End If
  235.         frmSetup1.Tag = strPathName
  236.         gintRetVal = gintRET_CONT
  237.         Unload Me
  238.     Else
  239.         txtPath.SetFocus
  240.     End If
  241.     SetMousePtr vbDefault
  242. End Sub
  243. Private Sub dirDirs_Change()
  244.     If mfSinkEvents Then
  245.         mfSinkEvents = False
  246.         txtPath.Text = dirDirs.Path
  247.         drvDrives.Drive = dirDirs.Path
  248.         mfSinkEvents = True
  249.     End If
  250. End Sub
  251. Private Sub drvDrives_Change()
  252.     Static strOldDrive As String
  253.     Dim strDrive As String
  254.     If mfSinkEvents Then
  255.         mfSinkEvents = False
  256.         If GetDrive(drvDrives.Drive, strDrive) Then
  257.             If CheckDrive(strDrive, Caption) Then
  258.                 strOldDrive = strDrive
  259.                 dirDirs.Path = strDrive
  260.                 txtPath.Text = dirDirs.Path
  261.             Else
  262.                 drvDrives.Drive = strOldDrive
  263.             End If
  264.         End If
  265.         mfSinkEvents = True
  266.     End If
  267. End Sub
  268. Private Sub Form_Load()
  269.     Dim strDrive As String
  270.     On Error Resume Next
  271.     mfSinkEvents = False
  272.     SetMousePtr vbHourglass
  273.     SetFormFont Me
  274.     cmdOK.Caption = ResolveResString(resBTNOK)
  275.     lblDrives.Caption = ResolveResString(resLBLDRIVES)
  276.     lblDirs.Caption = ResolveResString(resLBLDIRS)
  277.     lblPath.Caption = ResolveResString(resLBLPATH)
  278.     Caption = ResolveResString(resCHANGEDIR)
  279.     lblPrompt.Caption = ResolveResString(resDESTPROMPT)
  280.     cmdCancel.Caption = ResolveResString(resBTNCANCEL)
  281.     mfCancelExit = False
  282.     dirDirs.Path = gstrDestDir
  283.     If Err.Number <> 0 Then
  284.         'Next try root of destination drive
  285.         If GetDrive(gstrDestDir, strDrive) Then
  286.             Err.Clear
  287.             dirDirs.Path = strDrive
  288.         End If
  289.     End If
  290.     If Err.Number <> 0 Then
  291.         If GetDrive(App.Path, strDrive) Then
  292.             dirDirs.Path = strDrive
  293.         End If
  294.     End If
  295.     GetDrive dirDirs.Path, strDrive
  296.     drvDrives.Drive = strDrive
  297.     mfSinkEvents = True
  298.     'Init txtPath.Text to gstrDestDir even if this
  299.     '  directory does not (yet) exist.
  300.     txtPath.Text = gstrDestDir
  301.     mfMustExist = False
  302.     SetMousePtr vbDefault
  303.     CenterForm Me
  304.     'Highlight all of txtPath's text so that typing immediately overwrites it
  305.     txtPath.SelStart = 0
  306.     txtPath.SelLength = Len(txtPath.Text)
  307.     Err.Clear
  308. End Sub
  309. Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
  310.     If UnloadMode <> vbFormCode Then
  311.         If mfCancelExit Then
  312.             ExitSetup Me, gintRET_EXIT
  313.             Cancel = True
  314.         Else
  315.             gintRetVal = gintRET_CANCEL
  316.             Unload Me
  317.         End If
  318.     End If
  319. End Sub
  320.